home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr22
/
ctest259.zip
/
WHET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-09
|
7KB
|
250 lines
{$A+,B-,D-,E+,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
{$M 4096,0,655360}
UNIT Whet;
INTERFACE
FUNCTION WhetStone (Emu: BOOLEAN; Index: DOUBLE): DOUBLE;
IMPLEMENTATION
{ (C) Copyright, A H J Sale and British Standards Institution, 1982 }
{TEST 1.2-1, CLASS=QUALITY}
{: This program is a general check on execution speed. }
{ For details, see Computer Journal article, 'A Synthetic
Benchmark', Jan 1976 pp43-49. }
{V3.0: New test. }
{V5.1: Modified to introduce validation checks, 88-02-24}
{ The validation checks added have been made to avoid printing
values out which have no obvious purpose. In conversion to other
languages, the printing may cause timing problems. Merely
removing the printing statements is inadequate since then an
optimizing compiler could remove many of the modules completely. }
{ For details of checks and changes to avoid some problems,
see NPL report DITC 107/88. }
uses time;
type
real = double;
rlarray = array [ 1 .. 4 ] of real;
const
t = 0.499975;
t1 = 0.50025;
t2 = 2.0;
var
start, stop: integer;
wt: integer; { Determines length of execution }
x, y, z, norm, t3, estimate: real;
xx: record
one, two, three, four: real
end;
e1: rlarray;
i, jj, kk, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: integer;
ij, ik, il: 1 .. 4;
fail: boolean;
procedure pa(var e: rlarray);
label 1;
var j: integer;
begin
j := 0;
1 :
e[1] := (e[1] + e[2] + e[3] - e[4]) * t;
e[2] := (e[1] + e[2] - e[3] + e[4]) * t;
e[3] := (e[1] - e[2] + e[3] + e[4]) * t;
e[4] := ( - e[1] + e[2] + e[3] + e[4]) / t3; {changed from t2}
j := j + 1;
if j < 6 then
goto 1
end; {pa}
procedure p0;
begin
e1[ij] := e1[ik];
e1[ik] := e1[il];
e1[il] := e1[ij];
end; {p0}
procedure p3(x, y: real; var z: real);
begin
x := t * (z + x);
y := t * (x + y);
z := (x + y) / t2
end; {p3}
procedure Check(ModuleNo: integer; Condition: Boolean);
begin
if not Condition then
begin
writeln('Module ', ModuleNo:1, ' has not produced the expected',
' results');
writeln('Check listing and compare with Pascal version');
fail := true
end
end;
FUNCTION WhetStone (Emu: BOOLEAN; Index: DOUBLE): DOUBLE;
BEGIN
IF Emu THEN
wt := 1
ELSE
wt := Round (index / 3 + 1); { 10 corresponds to one million Whetstone
instructions
value shouldbe read to avoid the loop counters being
taken as constant. }
fail := false;
(* Check( 0, (wt >= 1) and (wt <= 100) );*)
n1 := 2 * wt;
n2 := 10 * wt;
n3 := 14 * wt;
n4 := 345 * wt;
n5 := 0;
n6 := 95 * wt;
n7 := 32 * wt;
n8 := 800 * wt;
n9 := 616 * wt;
n10 := 0;
n11 := 93 * wt;
start := clock;
{ module 1: simple identifiers}
xx.one := 1.0;
xx.two := -1.0; xx.three := -1.0; xx.four := -1.0;
for i := 1 to n1 do
begin
xx.one := (xx.one + xx.two + xx.three - xx.four) * t;
xx.two := (xx.one + xx.two - xx.three + xx.four) * t;
xx.three := (xx.one - xx.two + xx.three + xx.four) * t;
xx.four := ( - xx.one + xx.two + xx.three + xx.four) * t
end; {module 1}
with xx do
norm := sqrt(sqr(one)+sqr(two)+sqr(three)+sqr(four));
(* Check(1, abs(norm - exp(0.35735-n1*6.1e-5))/norm <= 0.1 );*)
{ module 2: array elements}
e1[1] := 1.0;
e1[2] := -1.0; e1[3] := - 1.0; e1[4] := - 1.0;
for i := 1 to n2 do
begin
e1[1] := (e1[1] + e1[2] + e1[3] - e1[4]) * t;
e1[2] := (e1[1] + e1[2] - e1[3] + e1[4]) * t;
e1[3] := (e1[1] - e1[2] + e1[3] + e1[4]) * t;
e1[4] := ( - e1[1] + e1[2] + e1[3] + e1[4]) * t
end; {module 2}
(* norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));*)
(* Check(2, abs(norm - exp(0.35735-n2*6.1e-5))/norm <= 0.1);*)
{ module 3: array as parameter}
t3 := 1.0/t;
for i := 1 to n3 do
pa(e1);
(* norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));*)
(* Check(3, abs(norm - exp(0.35735-(n3*5+n2)*6.1e-5))/norm <= 0.1 );*)
{ module 4: conditional jumps}
jj := 1;
for i:= 1 to n4 do
begin
if jj = 1 then
jj := 2
else
jj := 3;
if jj > 2 then
jj := 0
else
jj := 1;
if jj < 1 then
jj := 1
else
jj := 0
end; {module 4}
(* Check( 4, jj = ord(not odd(wt) ) );*)
{ module 5: omitted}
{ module 6: integer arithmetic}
ij := 1;
ik := 2;
il := 3;
for i := 1 to n6 do
begin
ij := ij * (ik - ij) * (il - ik);
ik := il * ik - (il - ij) * ik;
il := (il - ik) * (ik + ij);
e1[il - 1] := ij + ik + il;
e1[ik - 1] := ij * ik * il
end; {module 6}
(* Check( 6, (ij=1) and (ik=2) and (il=3) );*)
{module 7: trig. functions) }
x := 0.5; y := 0.5;
for i := 1 to n7 do
begin
x := t * arctan(t2 * sin(x) * cos(x) /
(cos(x + y) + cos (x - y) - 1.0));
y := t * arctan(t2 * sin(y) * cos(y) /
(cos(x + y) + cos (x - y) - 1.0))
end; {module 7}
(* Check(7, (t - wt* 0.0015 <= x) and
(x <= t - wt* 0.0004) and
(t - wt* 0.0015 <= y) and
(y <= t - wt* 0.0004) );*)
{module 8: procedure calls}
x := 1.0; y := 1.0; z := 1.0;
for i := 1 to n8 do
p3(y * i, y + z, z);
(* Check(8, abs(z - (0.99983352*n8 - 0.999555651)) <= n8*1.0e-6);*)
(* module 9: array references*)
ij := 1;
ik := 2;
il := 3;
e1[1] := 1.0;
e1[2] := 2.0;
e1[3] := 3.0;
for i := 1 to n9 do
p0;
(* Check(9, (e1[1] = 3.0) and (e1[2] = 2.0) and (e1[3] = 3.0) );*)
{ module 10: integer arithmetic}
jj := 2;
kk := 3;
for i := 1 to n10 do
begin
jj := jj + kk;
kk := jj + kk;
jj := kk - jj;
kk := kk - jj - jj;
end; {module 10}
(* Check(10, (jj=2) and (kk=3) );*)
{ module 11: standard functions}
x := 0.75;
for i := 1 to n11 do
x := sqrt (exp(ln(x) / t1));
(* estimate := 1.0 - exp(-0.0447*wt + ln(0.26));*)
(* Check( 11, (abs(estimate-x)/estimate
<= 0.0006 + 0.065/(5+wt) ));*)
stop := clock - start;
WhetStone := (100*wt/(stop*1e-3));
end;
END. { Whet }